unit uDZStream;

interface

uses
  SysUtils, Classes, RTLConsts;

type
  TDzAnsiStrStream = class(TStream)
  private
    fDataString: AnsiString;
    fPosition: Integer;
    procedure SetDataString(const Value: AnsiString);
  protected
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override;
  public
    constructor Create(const str: AnsiString);
    function Read(var Buffer; Count: Longint): Longint; override;
    function ReadString(Count: Longint): AnsiString;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function WriteInt(value: Integer): LongInt;
    procedure WriteString(const str: AnsiString);
    procedure FormatWrite(const fmt: AnsiString; const args: array of const);
    procedure FormatWriteBuf(const fmt: PAnsiChar; FmtLen: Integer; args: array of const);
    property DataString: AnsiString read fDataString write SetDataString;
  end;

  TDzWideStrStream = class(TStream)
  private
    fDataString: WideString;
    fPosition: Integer;
    procedure SetDataString(const Value: WideString);
  protected
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override;
  public
    constructor Create(const str: WideString);
    function Read(var Buffer; Count: Longint): Longint; override;
    function ReadString(Count: Longint): WideString;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function WriteInt(value: Integer): Integer;
    procedure WriteString(const str: WideString);
    procedure FormatWrite(const fmt: WideString; const args: array of const);
    procedure FormatWriteBuf(const fmt: PWideChar;
      FmtLen: Integer; args: array of const);
    property DataString: WideString read fDataString write SetDataString;
  end;

  {$IFDEF UNICODE}
  TDzStringStream = TDzWideStrStream;
  {$ELSE}
  TDzStringStream = TDzAnsiStrStream;
  {$ENDIF}
  
  TPointerStreamWrapper = class(TStream)
  private
    fMemory: Pointer;
    fCapacity, fSize, fPosition: Longint;
    procedure SetCapacity(NewCapacity: Longint);
  protected
    procedure SetSize(NewSize: Longint); override;
  public
    destructor Destroy; override;
    procedure SaveToStream(Stream: TStream);
    procedure SaveToFile(const FileName: string);
    procedure SetPointer(Ptr: Pointer; Size: Longint);
    function Extract: Pointer;
    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property Memory: Pointer read fMemory;
    property Capacity: Longint read fCapacity write SetCapacity;
  end;

implementation

{ TDzAnsiStrStream }

constructor TDzAnsiStrStream.Create(const str: AnsiString);
begin
  inherited Create;
  fDataString := str;
  fPosition := 0; 
end;

procedure TDzAnsiStrStream.FormatWrite(const fmt: AnsiString;
  const args: array of const);
begin
  WriteString(Format(fmt, args));
end;

procedure TDzAnsiStrStream.FormatWriteBuf(const fmt: PAnsiChar; FmtLen: Integer;
  args: array of const);
var
  CharWrites: Integer; 
begin
  CharWrites := FormatBuf(fDataString[fPosition + 1],
    Size - Position, fmt^, FmtLen, args);
  Seek(CharWrites, soFromCurrent);
end;

function TDzAnsiStrStream.GetSize: Int64;
begin
  Result := Length(fDataString);
end;

function TDzAnsiStrStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := Length(fDataString) - fPosition;
  if Result > Count then Result := Count;
  if Result > 0 then Move(fDataString[fPosition + 1], Buffer, Result);
  Inc(fPosition, Result);
end;

function TDzAnsiStrStream.Write(const Buffer; Count: Longint): Longint;
var
  newSize: LongInt;
begin
  Result := Count;
  newSize := fPosition + Result;
  if newSize > Size then SetLength(fDataString, newSize);
  Move(Buffer, fDataString[fPosition + 1], Result);
  Inc(fPosition, Result);
end;

function TDzAnsiStrStream.WriteInt(value: Integer): LongInt;
var
  buf: array [0..15] of AnsiChar;
  n: Integer;
  neg: Boolean;
begin
  if value < 0 then
  begin
    neg := True;
    value := -value;
  end
  else neg := False;
  n := 15;
  repeat
    buf[n] := AnsiChar(value mod 10 + $30);
    value := value div 10;
    Dec(n);
  until value = 0;
  if neg then
  begin
    buf[n] := '-';
    Dec(n);
  end;
  Result := Write(buf[n + 1], 15 - n);
end;

function TDzAnsiStrStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: fPosition := Offset;
    soFromCurrent: fPosition := fPosition + Offset;
    soFromEnd: fPosition := Length(fDataString) - Offset;
  end;
  if fPosition > Length(fDataString) then fPosition := Length(fDataString)
  else if fPosition < 0 then fPosition := 0;
  Result := fPosition;
end;

function TDzAnsiStrStream.ReadString(Count: Longint): AnsiString;
var
  Len: Integer;
begin
  Len := Length(fDataString) - fPosition;
  if Len > Count then Len := Count;
  SetLength(Result, len);
  Move(fDataString[fPosition + 1], Result[1], Len);
  Inc(fPosition, Len);
end;

procedure TDzAnsiStrStream.WriteString(const str: AnsiString);
begin
  Write(str[1], Length(str));
end;

procedure TDzAnsiStrStream.SetDataString(const Value: AnsiString);
begin
  fDataString := Value;
  if fPosition > Length(fDataString) then fPosition := Length(fDataString);
end;

procedure TDzAnsiStrStream.SetSize(NewSize: Longint);
begin
  if NewSize = Size then Exit;
  SetLength(fDataString, NewSize);
  if fPosition > NewSize then fPosition := NewSize;
end;

{ TDzWideStrStream }

constructor TDzWideStrStream.Create(const str: WideString);
begin
  inherited Create;
  fDataString := str;
  fPosition := 0;
end;

procedure TDzWideStrStream.FormatWrite(const fmt: WideString;
  const args: array of const);
begin
  WriteString(WideFormat(fmt, args));
end;

procedure TDzWideStrStream.FormatWriteBuf(const fmt: PWideChar;
  FmtLen: Integer; args: array of const);
var
  CharWrites: Integer; 
begin
  CharWrites := WideFormatBuf(fDataString[(fPosition + 2) div 2],
    (Size - fPosition) div 2, fmt^, FmtLen, args);
  Inc(fPosition, CharWrites * SizeOf(WideChar));
end;

function TDzWideStrStream.GetSize: Int64;
begin
  Result := Length(fDataString) * SizeOf(WideChar);
end;

function TDzWideStrStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := Size - fPosition;
  if Result > Count then Result := Count;
  Move(fDataString[(fPosition + 2) div 2], Buffer, Result);
  Inc(fPosition, Result);
end;

function TDzWideStrStream.Write(const Buffer; Count: Longint): Longint;
var
  newSize: LongInt;
begin
  Result := Count;
  newSize := fPosition + Count  div 2;
  if newSize > Size then SetLength(fDataString, newSize div 2);
  Move(Buffer, fDataString[(fPosition + 2) div 2], Result);
  Inc(fPosition, Result);
end;

function TDzWideStrStream.WriteInt(value: Integer): Integer;
var
  buf: array [0..15] of WideChar;
  n: Integer;
  neg: Boolean;
begin
  if value < 0 then
  begin
    neg := True;
    value := -value;
  end
  else neg := False;
  n := 15;
  repeat
    buf[n] := WideChar(value mod 10 + $30);
    value := value div value;
    Dec(n);
  until value = 0;
  if neg then
  begin
    buf[n] := '-';
    Dec(n);
  end;
  Result := Write(buf[n + 1], 30 - n * 2);
end;

function TDzWideStrStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: fPosition := Offset;
    soFromCurrent: fPosition := fPosition + Offset;
    soFromEnd: fPosition := Size - Offset;
  end;
  if fPosition > Size then fPosition := Size
  else if fPosition < 0 then fPosition := 0;
  Result := fPosition;
end;

function TDzWideStrStream.ReadString(Count: Longint): WideString;
var
  Len: Integer;
begin
  fPosition := 2* ((fPosition + 1) div 2);
  Len := Size - fPosition;
  if Len > Count * 2 then Len := Count * 2;
  SetLength(Result, len div 2);
  Move(fDataString[(fPosition + 2) div 2], Result[1], Len);
  Inc(fPosition, Len);
end;

procedure TDzWideStrStream.WriteString(const str: WideString);
begin
  fPosition := ((fPosition + 1) div 2) * 2;
  Write(str[1], Length(str) * SizeOf(WideChar));
end;

procedure TDzWideStrStream.SetDataString(const Value: WideString);
begin
  fDataString := Value;
  if fPosition > Size then fPosition := Size;
end;

procedure TDzWideStrStream.SetSize(NewSize: Longint);
begin
  NewSize := 2 * ((NewSize + 1) div 2);
  if NewSize = Size then Exit;
  SetLength(fDataString, NewSize div 2);
  if fPosition > NewSize then fPosition := NewSize;
end;

const
  MemoryDelta = $2000; { Must be a power of 2 }
  
{ TPointerStreamWrapper }

procedure TPointerStreamWrapper.Clear;
begin
  if Assigned(fMemory) then FreeMemory(fMemory);
  fMemory := nil;
  fCapacity := 0;
  fSize := 0;
  fPosition := 0;
end;

destructor TPointerStreamWrapper.Destroy;
begin
  Clear;
  inherited;
end;

function TPointerStreamWrapper.Extract: Pointer;
begin
  Result := fMemory;
  fMemory := nil;
  fSize := 0;
  fCapacity := 0;
  fPosition := 0;
end;

procedure TPointerStreamWrapper.LoadFromFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPointerStreamWrapper.LoadFromStream(Stream: TStream);
var
  Count: Longint;
begin
  Stream.Position := 0;
  Count := Stream.Size;
  SetSize(Count);
  if Count <> 0 then Stream.ReadBuffer(fMemory^, Count);
end;

function TPointerStreamWrapper.Read(var Buffer; Count: Integer): Longint;
begin
  if (fPosition >= 0) and (Count >= 0) then
  begin
    Result := fSize - fPosition;
    if Result > 0 then
    begin
      if Result > Count then Result := Count;
      Move(Pointer(Longint(fMemory) + fPosition)^, Buffer, Result);
      Inc(fPosition, Result);
      Exit;
    end;
  end;
  Result := 0;
end;

procedure TPointerStreamWrapper.SaveToFile(const FileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TPointerStreamWrapper.SaveToStream(Stream: TStream);
begin
  if fSize <> 0 then Stream.WriteBuffer(fMemory^, fSize);
end;

function TPointerStreamWrapper.Seek(Offset: Integer; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning: fPosition := Offset;
    soFromCurrent: Inc(fPosition, Offset);
    soFromEnd: fPosition := fSize + Offset;
  end;
  Result := fPosition;
end;

procedure TPointerStreamWrapper.SetCapacity(NewCapacity: Integer);
begin
  if (NewCapacity < 0) or (NewCapacity = fCapacity) then Exit;
  if NewCapacity = 0 then
  begin
    Clear;
    Exit;
  end;

  NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);

  if fMemory = nil then fMemory := GetMemory(NewCapacity)
  else fMemory := ReallocMemory(fMemory, NewCapacity);

  if fMemory = nil then
    raise EStreamError.CreateRes(@SMemoryStreamError);

  fCapacity := NewCapacity;
  if fSize > fCapacity then fSize := fCapacity;
  if fPosition > fCapacity then fPosition := fCapacity;
end;

procedure TPointerStreamWrapper.SetPointer(Ptr: Pointer; Size: Integer);
begin
  Clear;
  fMemory := Ptr;
  fCapacity := Size;
  fSize := Size;
  if fPosition > fSize then fPosition := fSize;
end;

procedure TPointerStreamWrapper.SetSize(NewSize: Integer);
begin
  SetCapacity(NewSize);
  fSize := NewSize;
end;

function TPointerStreamWrapper.Write(const Buffer; Count: Integer): Longint;
var
  Pos: Longint;
begin
  if (fPosition >= 0) and (Count >= 0) then
  begin
    Pos := fPosition + Count;
    if Pos > 0 then
    begin
      if Pos > fSize then
      begin
        if Pos > fCapacity then SetCapacity(Pos);
        fSize := Pos;
      end;
      System.Move(Buffer, Pointer(Longint(fMemory) + fPosition)^, Count);
      fPosition := Pos;
      Result := Count;
      Exit;
    end;
  end;
  Result := 0;
end;

end.
